home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
16
/
context.zip
/
CONTEXT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1986-10-22
|
31KB
|
956 lines
program context;
{
Version 1.0, Oct 1986.
Converts disk text formats from one DOS word processor to another.
Formats: ASCII, WordStar/NewWord, WordPerfect, PCWrite, Personal Editor.
By Jim Boylston, Charlotte KUG BBS #1, 704/372-6225
}
label quit;
var
infile, outfile : text;
inname, outname : string[64];
informat, outformat, letter, a, b, d, e : char;
valid, sub : boolean;
counter : integer;
procedure firstScreen;
begin
clrscr;
writeln; writeln;
writeln (' CONTEXT v1.0');
writeln (' ------------');
writeln (' Convert text formats for word processors');
writeln;
writeln (' Available formats:');
writeln (' A: plain ASCII');
writeln (' B: WordStar/NewWord');
writeln (' C: WordPerfect');
writeln (' D: Personal Editor');
writeln (' E: PCWrite');
writeln;
end;
procedure getformat (var format : char);
begin
valid := true;
write ('format -> ');
read (kbd, format);
case format of
'A', 'a' : writeln ('ASCII');
'B', 'b' : writeln ('WordStar/NewWord');
'C', 'c' : writeln ('WordPerfect');
'D', 'd' : writeln ('Personal Editor');
'E', 'e' : writeln ('PCWrite');
else begin
valid := false;
writeln ('not a valid choice');
end;
end; {case}
end; {procedure getformat}
procedure getinfile;
var ok : boolean;
begin
repeat
writeln (' Source filename');
write (' (drive:\dir allowed) -> ');
readln (inname);
assign (infile, inname);
{$I-} reset (infile) {$I+};
ok := (IOresult = 0);
if not ok then writeln (' Can''t find source file. Try again.');
until ok;
writeln;
end; {procedure getinfile}
procedure getoutfile;
var
answer : char;
ok : boolean;
begin
repeat
writeln (' Destination filename');
write (' (drive:\dir allowed) -> ');
readln (outname);
assign (outfile, outname);
{$I-} reset (outfile) {$I+};
if IOresult = 0 then begin
write (' File already exists. Overwrite? (Y/N) '); readln (answer);
ok := (upcase (answer) ='Y');
end {if}
else ok := true;
until ok;
rewrite (outfile);
end; {procedure getoutfile}
{==============================================}
{ SUBROUTINES CALLED BY TRANSLATION PROCEDURES }
{==============================================}
procedure epsoncodes2ws;
{ translates Personal Editor Epson codes to WS }
begin
case ord (d) of { d = the 1st char of printer code }
45 : begin { underline }
write (outfile, ^S);
if not eof (infile) then read (infile, d);
end;
69 : begin
write (outfile, ^B); { bold begin }
d := e;
end;
70 : begin
write (outfile, ^B); { bold end }
d := e;
end;
83 : begin { sub and superscripts }
if e = '1' then begin { it's a subscript }
sub := true;
write (outfile, ^V);
end
else { it's a superscript }
write (outfile, ^T);
if not eof (infile) then read (infile, d);
end;
84 : begin { scripts off }
if sub then begin
write (outfile, ^V);
end
else begin
write (outfile, ^T);
end;
d := e;
sub := false;
end;
end; { case }
if not eof (infile) then read (infile, e); { now have new d & e }
end; { procedure epsoncodes2ws }
procedure epsoncodes2wp;
{ translates Personal Editor Epson codes to PW }
begin
case ord (d) of
45 : begin { underline }
if e = '1' then write (outfile, chr(148))
else write (outfile, chr(149));
if not eof (infile) then read (infile, d);
end;
69 : begin
write (outfile, chr(157)); { bold begin }
d := e;
end;
70 : begin
write (outfile, chr(156)); { bold end }
d := e;
end;
83 : begin { sub and superscripts }
if e = '1' then begin { it's a subscript }
sub := true;
write (outfile, chr(189));
end
else write (outfile, chr(188)); { it's a superscript }
if not eof (infile) then read (infile, d);
end; { scripts begin }
84 : begin
if sub then sub := false; { scripts end }
d := e;
end;
end; { case }
if not eof (infile) then read (infile, e); { now have new d & e }
end; { procedure epsoncodes2wp }
procedure epsoncodes2pcw;
{ translates Personal Editor Epson codes to PCW }
begin
read (infile, letter); { get the printer code }
case ord (letter) of
45 : begin { underline }
write (outfile, ^W);
read (infile, letter);
end;
52 : write (outfile, ^U); { italic begin }
53 : write (outfile, ^U); { italic end }
69 : write (outfile, ^B); { bold begin }
70 : write (outfile, ^B); { bold end }
83 : begin { sub and superscripts }
read (infile, letter);
if letter = '1' then begin { it's a subscript }
sub := true;
write (outfile, ^Y);
end
else write (outfile, ^X); { it's a superscript }
end; { scripts begin }
84 : if sub then begin { scripts end }
write (outfile, ^Y);
sub := false;
end
else write (outfile, ^X);
end; { case }
end; { procedure epsoncodes2pcw }
{=======================================}
{SECTION FOR ACTUAL TRANSLATION ROUTINES}
{=======================================}
{ FROM ASCII TO OTHERS }
procedure ascii2ws; { doubles as pe2ws }
{ read letters from infile 1 by 1, check against the two preceding chars
called a and b, and the two following chars called d and e }
begin
sub := false;
a := chr(0); b := chr(0); { null these characters for now }
while not eof (infile) do begin
read (infile, letter);
while not eof (infile) do begin
read (infile, d); { read 2 char ahead }
while not eof (infile) do begin
read (infile, e);
case letter of
^I : write (outfile, ' '); {convert tab to 5 spaces}
^J : write (outfile, ^J);
^L : write (outfile, ^M, ^J, '.PA', ^M, ^J); { hard page }
^M : if (a = ^M) or (e = ^M) then write (outfile, ^M)
else write (outfile, chr(141)); { make soft cr if not 2 in a row}
^[ : epsoncodes2ws; { PE 'esc' printer codes - convert to WS code }
else if d = ' ' then write (outfile, chr(ord(letter) + 128))
else write (outfile, letter);
end; {case}
a := b; b := letter; letter := d; d := e; { shift char assignments }
end; { while not eof #3 }
write (outfile, letter, d, ^M, ^J); { flush the last chars, add final cr }
end; { while not eof #2 }
end; { while not eof #1 }
end; {procedure ascii2ws}
procedure ascii2wp; { doubles as pe2wp }
begin
sub := false;
a := chr(0); b := chr(0);
while not eof (infile) do begin
read (infile, letter);
while not eof (infile) do begin
read (infile, d);
while not eof (infile) do begin
read (infile, e);
case letter of
^[ : epsoncodes2wp; { PE 'esc' printer codes - convert to WP code }
^L : write (outfile, chr(220), ^\,^@,^@,^@,^@,^@,^@, chr(220), ^L);
^M : if (a = ^M) or (e = ^M) then write (outfile, ^J)
else write (outfile, ^M);
' ' : if d <> ^M then write (outfile, ' '); { no end of line spaces }
'-' : write (outfile, chr(169)); { WP hard hyphen }
else if letter <> ^J then write (outfile, letter);
{ don't translate linefeeds }
end; { case }
a := b; b := letter; letter := d; d := e; { shift letter assignments }
end; { while not eof #3 }
write (outfile, d, ^J); { flush last character, add lf }
end; { while not eof #2 }
end; { while not eof #1 }
end; { procedure ascii2wp }
{ procedure ascii2pe not needed }
procedure ascii2pcw;
var letter : char;
begin
while not eof (infile) do begin
read (infile, letter);
case letter of
^I : write (outfile, ' '); { tab to 6 spaces }
^L : write (outfile, ^L, ^O, ^M, ^J); { hardpage }
else write (outfile, letter);
end; { case }
end; { while not eof }
end; { procedure ascii2pcw }
{FROM WORDSTAR/NEWWORD TO OTHERS}
procedure ws2ascii;
begin;
while not eof (infile) do begin
read (infile, letter);
letter := chr(ord(letter) mod 128); {get rid of high bits}
case letter of { ignore all controls chars but these 2 }
^J : write (outfile, ^J);
^M : write (outfile, ^M);
else if ord(letter) > 31
then write (outfile, letter);
end; { case }
end; {while}
end; {procedure ws2ascii}
procedure ws2wp;
var
letter2 : char;
underline, bold, italic, super : boolean;
begin
underline := false; bold := false; italic := false;
while not eof (infile) do begin
read (infile, letter);
while not eof (infile) do begin
read (infile, letter2);
case ord (letter) of
2 : if not bold then begin
write (outfile, chr(157));
bold := true;
end
else begin
write (outfile, chr(156));
bold := false;
end;
4 : if not bold then begin
write (outfile, chr(157));
bold := true;
end
else begin
write (outfile, chr(156));
bold := false;
end;
13 : write (outfile, ^J); { hardcr }
19 : if not underline then begin
write (outfile, chr(148));
underline := true
end
else begin
write (outfile, chr(149));
underline := false;
end;
20 : if not super then begin
write (outfile, chr(188));
super := true;
end
else super := false; { superscripts }
22 : if not sub then begin
write (outfile, chr(189));
sub := true;
end
else sub := false;
25 : if not italic then begin
write (outfile, chr(203), ^L, ^A, ^L, ^D, chr(203));
italic := true;
end
else begin
write (outfile, chr(203), ^L, ^D, ^L, ^A, chr(203));
italic := false;
end;
32 : if letter2 <> ^M then write (outfile, ' ');
45 : write (outfile, chr(173)); { hyphen }
141 : write (outfile, ^M); { softcr }
173 : write (outfile, 173); { soft hyphen }
else if (ord (letter) > 31) and (ord (letter) <> 160) { soft sp }
then write (outfile, chr (ord (letter) mod 128));
end; { case }
letter := letter2;
end; { while not eof #2 }
write (outfile, letter, ^J); { flush last char, add lf }
end { while not eof #1 }
end; {procedure ws2wp}
procedure ws2pe; { resembles ws2ascii and ws2pcw }
var underline, bold, super : boolean;
begin
underline := false; bold := false; super := false; sub := false;
while not eof (infile) do begin
read (infile, letter);
case letter of
^B : if not bold then begin
write (outfile, ^[, 'E');
bold := true;
end
else begin
write (outfile, ^[, 'F');
bold := false;
end;
^D : if not bold then begin
write (outfile, ^[, 'E');
bold := true;
end
else begin
write (outfile, ^[, 'F');
bold := false;
end;
^S : if not underline then begin
write (outfile, ^[, '-1');
underline := true;
end
else begin
write (outfile, ^[, '-0');
underline := false;
end;
^T : if not super then begin
write (outfile, ^[, 'S0');
super := true;
end
else begin
write (outfile, ^[, 'T');
super := false;
end;
^V : if not sub then begin
write (outfile, ^[, 'S1');
sub := true;
end
else begin
write (outfile, ^[, 'T');
sub := false;
end;
else if ord (letter) <> 160 { omit soft spaces }
then write (outfile, chr (ord (letter) mod 128));
end; { case }
end; { while not eof }
end; { procedure ws2pe }
procedure ws2pcw;
var
underline : boolean;
begin
underline := false;
while not eof (infile) do begin
read (infile, letter);
case letter of
^B : write (outfile, ^B); { bold }
^D : write (outfile, ^B);
^J : write (outfile, ^J);
^M : if underline then begin { must start underline anew each line }
write (outfile, ^W, ^M, ^J, ^W);
read (infile, letter); { skip the linefeed }
end { if underline }
else write (outfile, ^M);
^S : begin
write (outfile, ^W); { underline }
if (underline = false) then underline := true
else underline := false;
end;
^T : write (outfile, ^X); { superscript }
^V : write (outfile, ^Y); { subscript }
^Y : write (outfile, ^U); { italic }
else if (ord (letter) > 31) and (ord(letter) <> 160)
then write (outfile, chr(ord(letter) mod 128));
end; { case }
end; {while}
end; { procedure ws2pcw }
{FROM WORDPERFECT TO OTHERS}
procedure wp2ascii;
begin
while not eof (infile) do begin
read (infile, letter);
case ord(letter) of
9 : write (outfile, ^I);
10 : write (outfile, ^M, ^J);
13 : write (outfile, ' ', ^M, ^J);
169 : write (outfile, '-'); { WordPerfect special hyphen chars }
170 : write (outfile, '-', ^M, ^J);
173 : write (outfile, '-');
194 : for counter := 1 to 2 do read (infile, letter); { skip mar rel }
195 : for counter := 1 to 4 do read (infile, letter); { centered }
196 : for counter := 1 to 4 do read (infile, letter); { flush right }
203 : for counter := 1 to 5 do read (infile, letter); { skip font changes }
204 : for counter := 1 to 3 do read (infile, letter); { indented paragraph }
209 : repeat { headers and footers not translated }
read (infile, letter)
until letter = chr(209);
220 : begin { page break }
for counter := 1 to 9 do read (infile, letter);
write (outfile, ^L);
end;
222 : for counter := 1 to 3 do read (infile, letter); { indented paragraph }
else if (ord(letter) > 31 ) and (ord(letter) < 127) then
write (outfile, letter);
end; { case }
end; { while not eof }
end; { procedure wp2ascii }
procedure wp2ws;
var
letter2 : char;
header, indent : boolean; { special formats }
begin
header := false; indent := false;
while not eof (infile) do begin
read (infile, letter);
while not eof (infile) do begin
read (infile, letter2);
case ord(letter) of
2 : if header then write (outfile, '#');
9 : write ( outfile, ' '); { tab -> 5 spaces }
10 : if not header then write ( outfile, ^M, ^J); { hardcr }
13 : if indent then write ( outfile, ' ', chr(141), ^J, chr(160),
chr(160), chr(160), chr(160), chr(160)) { 5 soft spaces }
else write ( outfile, ' ', chr(141), ^J); { space, softcr }
{ special provision for reverse indented paragraphs }
148 : write ( outfile, ^S); { begin underline }
149 : write ( outfile, ^S); { end underline }
156 : write ( outfile, ^B); { end bold print }
157 : write ( outfile, ^B); { begin bold print }
169 : write ( outfile, '-'); { WP hard hyphen }
170 : write (outfile, '-', chr(141), ^J); { WP hyphen end of line }
173 : write (outfile, chr(173)); { soft hyphen }
194 : for counter := 1 to 2 do read (infile, letter2); { mar rel }
195 : for counter := 1 to 4 do read (infile, letter2); { centered }
196 : for counter := 1 to 4 do read (infile, letter2); { flush right }
203 : begin
for counter := 1 to 5 do read (infile, letter2); { font changes }
write (outfile, ^Y);
end;
204 : begin
indent := true;
for counter := 1 to 3 do read (infile, letter2);
end;
209 : if header = false then begin { headers AND footers }
header := true;
if (letter2 = ^A) or (letter2 = ^@)
then write (outfile, ^M, ^J, '.HE')
else write (outfile, ^M, ^J, '.FO');
for counter := 1 to 6 do read (infile, letter2);
end
else begin
header := false;
write (outfile, ^M, ^J);
end;
220 : if letter2 = ^\ then begin
write (outfile, ^M, ^J, '.PA', ^M, ^J);
for counter := 1 to 9 do read (infile, letter2);
end;
222 : begin
indent := false; { WP end indented paragraph marker }
for counter := 1 to 3 do read (infile, letter2);
end;
else if (ord (letter) > 31) and (ord (letter) < 127) then begin
if letter2 = ' ' then write (outfile, chr (ord(letter) + 128))
else write (outfile, letter);
end; { if ord > 31 ..: Puts in soft chars }
end; { case }
letter := letter2;
end; { while not eof #2 }
write (outfile, letter);
end; { while not eof #1 }
end; { procedure wp2ws }
procedure wp2pe;
begin
while not eof (infile) do begin
read (infile, letter);
case ord(letter) of
9 : write (outfile, ^I);
10 : write (outfile, ^M, ^J);
13 : write (outfile, ' ', ^M, ^J);
148 : write (outfile, ^[, '-1'); { underline begin }
149 : write (outfile, ^[, '-0'); { underline end }
156 : write (outfile, ^[, 'F'); { bold end }
157 : write (outfile, ^[, 'E'); { bold begin }
169 : write (outfile, '-'); { WordPerfect special hyphen chars }
170 : write (outfile, '-', ^M, ^J);
173 : write (outfile, '-');
188 : begin { superscript }
write (outfile, ^[, 'S0');
read (infile, letter);
write (outfile, letter, ^[, 'T');
end;
189 : begin { subscript }
write (outfile, ^[, 'S1');
read (infile, letter);
write (outfile, letter, ^[, 'T');
end;
194 : for counter := 1 to 2 do read (infile, letter); { mar rel }
195 : for counter := 1 to 4 do read (infile, letter); { center }
196 : for counter := 1 to 4do read (infile, letter); { flush right }
203 : for counter := 1 to 5 do read (infile, letter); { font changes }
204 : for counter := 1 to 3 do read (infile, letter); { indented paragraph }
209 : repeat { headers and footers not translated }
read (infile, letter)
until letter = chr(209);
220 : begin { page break }
for counter := 1 to 9 do read (infile, letter);
write (outfile, ^L, ^M, ^J);
end;
222 : for counter := 1 to 3 do read (infile, letter); { indented }
else if (ord(letter) > 31 ) and (ord(letter) < 127) then
write (outfile, letter);
end; { case }
end; { while not eof }
end; { procedure wp2pe }
procedure wp2pcw;
var
underline, header : boolean;
begin
underline := false; header := false;
while not eof (infile) do begin
read (infile, letter);
case ord(letter) of
9 : write (outfile, ' '); { tab to 6 spaces }
10 : if underline then write (outfile, ^W, ^M, ^J, ^W)
else write (outfile, ^M, ^J);
13 : if underline then write (outfile, ' ', ^M, ^J, ^W)
else write (outfile, ' ', ^M, ^J);
148 : begin
underline := true;
write (outfile, ^W);
end;
149 : begin
underline := false;
write (outfile, ^W);
end;
156 : write ( outfile, ^B); { end bold print }
157 : write ( outfile, ^B); { begin bold print }
169 : write (outfile, '-'); { WordPerfect special hyphen chars }
170 : write (outfile, '-', ^M, ^J);
173 : write (outfile, '-');
188 : begin { superscript }
write (outfile, ^X);
if not eof (infile) then read (infile, letter);
write (outfile, letter);
write (outfile, ^X);
end;
189 : begin { subscript }
write (outfile, ^Y);
if not eof (infile) then read (infile, letter);
write (outfile, letter);
write (outfile, ^Y);
end;
195 : for counter := 1 to 4 do read (infile, letter);
196 : for counter := 1 to 4 do read (infile, letter); { flush right }
203 : begin { italic or font change }
for counter := 1 to 5 do read (infile, letter);
write (outfile, ^U);
end;
204 : for counter := 1 to 3 do read (infile, letter);
208 : for counter := 1 to 2 do read (infile, letter);
209 : if header = false then begin
header := true;
read (infile, letter);
if (letter = ^A) or (letter = ^@)
then write (outfile, ^M, ^J, '.H:')
else write (outfile, ^M, ^J, '.F:');
for counter := 1 to 5 do read (infile, letter);
end
else begin
header := false;
write (outfile, ^M, ^J);
end;
220 : begin { page break }
read (infile, letter);
if letter = ^\ then begin
write (outfile, ^L, ^O, ^M, ^J);
end; { if }
for counter := 1 to 8 do read (infile, letter);
end; { 220 }
222 : for counter := 1 to 3 do read (infile, letter); { mar rel not }
else if (ord(letter) > 31 ) and (ord(letter) < 127) then
write (outfile, letter);
end; { case }
end; { while not eof }
end; { wp2pcw }
{ FROM PERSONAL EDITOR TO OTHERS }
procedure pe2ascii;
{ pe is ascii with embedded Epson printer commands }
var letter : char;
begin
while not eof (infile) do begin
read (infile, letter);
if letter = ^[ then begin { printer code }
read (infile, letter); { read the next character }
case letter of
'W' : read (infile, letter); { skip a character }
'S' : read (infile, letter); { skip a character }
'-' : read (infile, letter); { skip a character }
'm' : read (infile, letter); { skip a character }
end; { case }
end { if }
else if letter <> ^I then write (outfile, letter);
end; { while not eof }
end; { pe2ascii }
procedure pe2ws;
begin
ascii2ws;
end; { procedure pe2ws }
procedure pe2wp;
begin
ascii2wp;
end; { procedure pe2wp }
procedure pe2pcw;
begin
sub := false;
while not eof (infile) do begin
read (infile, letter);
case letter of
^I : write (outfile, ' '); { tab to 6 spaces }
^L : write (outfile, ^L, ^O, ^M, ^J); { hardpage }
^[ : epsoncodes2pcw; { PE printer code - convert to PCW }
else write (outfile, letter);
end; { case }
end; { while not eof }
end; { procedure pe2pcw }
{ FROM PCWRITE TO OTHERS }
procedure pcw2ascii;
var letter : char;
begin
while not eof (infile) do begin
read (infile, letter);
case letter of
^M : write (outfile, ^M); { ignore all control chars except these }
^J : write (outfile, ^J);
^L : write (outfile, ^L);
else if ord(letter) > 31 then write (outfile, letter);
end; { case }
end; { while not eof }
end; { procedure pcw2ascii }
procedure pcw2ws;
{ the same as ascii2ws with printer codes added }
begin
a := chr(0); b := chr(0); { null these characters for now }
while not eof (infile) do begin
read (infile, letter);
while not eof (infile) do begin
read (infile, d); { read 2 char ahead }
while not eof (infile) do begin
read (infile, e);
case letter of
^B : write (outfile, ^B); { bold }
^J : write (outfile, ^J);
^L : begin
write (outfile, ^M, ^J, '.PA', ^M, ^J); { hard page }
d := e; read (infile, e); { skip the ^O }
end;
^M : if (a = ^M) or (e = ^M) then write (outfile, ^M)
else write (outfile, chr(141)); { make soft cr if not 2 in a row}
^U : write (outfile, ^Y); { italic }
^W : write (outfile, ^S); { underline }
^X : write (outfile, ^T); { superscript }
^Y : write (outfile, ^V); { subscript }
else if d = ' ' then write (outfile, chr(ord(letter) + 128))
else write (outfile, letter);
end; {case}
a := b; b := letter; letter := d; d := e; { shift char assignments }
end; { while not eof #3 }
write (outfile, letter, d, ^M, ^J); { flush last chars, add final cr }
end; { while not eof #2 }
end; { while not eof #1 }
end; { procedure pcw2ws }
procedure pcw2wp;
{ nearly same as ascii2wp }
var
bold, italic, underline, super : boolean;
begin
a := chr(0); b := chr(0);
while not eof (infile) do begin
read (infile, letter);
while not eof (infile) do begin
read (infile, d);
while not eof (infile) do begin
read (infile, e);
case letter of
^B : if not bold then begin
write (outfile, chr(157));
bold := true;
end
else begin
write (outfile, chr(156));
bold := false;
end;
^L : begin { page break }
write (outfile, chr(220), ^\,^@,^@,^@,^@,^@,^@, chr(220), ^L);
d := e;
if not eof (infile) then read (infile, e);
end;
^M : if (a = ^M) or (e = ^M) then write (outfile, ^J)
else write (outfile, ^M);
^U : if not italic then begin
write (outfile, chr(203), ^L, ^A, ^L, ^D, chr(203));
italic := true;
end
else begin
write (outfile, chr(203), ^L, ^D, ^L, ^A, chr(203));
italic := false;
end;
^W : if not underline then begin
write (outfile, chr(148));
underline := true;
end
else begin
write (outfile, chr(149));
underline := false;
end;
^X : if not super then begin
write (outfile, chr(188));
super := true;
end
else super := false;
^Y : if not sub then begin
write (outfile, chr(189));
sub := true;
end
else sub := false;
' ' : if (d <> ^M) and (d <> ' ') { gets rid of right just. }
then write (outfile, ' '); { and end of line spaces }
'-' : write (outfile, chr(169)); { WP hard hyphen }
else if letter <> ^J then write (outfile, letter);
{ don't translate linefeeds }
end; { case }
a := b; b := letter; letter := d; d := e; { shift letter assignments }
end; { while not eof #3 }
write (outfile, d, ^J); { flush last character }
end; { while not eof #2 }
end; { while not eof #1 }
end; { procedure pcw2wp }
procedure pcw2pe;
var
underline, bold, super : boolean;
begin
underline := false; bold := false; super := false; sub := false;
while not eof (infile) do begin
read (infile, letter);
case letter of
^B : if bold = false then begin
write (outfile, ^[, 'E');
bold := true;
end
else begin
write (outfile, ^[, 'F');
bold := false;
end;
^L : begin { formfeed }
write (outfile, ^L);
read (infile, letter); { skip the ^O that follows }
end;
^W : if underline = false then begin
write (outfile, ^[,'-1');
underline := true;
end
else begin
write (outfile, ^[, '-0');
underline := false;
end;
^X : if not super then begin
write (outfile, ^[, 'S0');
super := true;
end
else begin
write (outfile, ^[, 'T');
super := false;
end;
^Y : if not sub then begin
write (outfile, ^[,'S1');
sub := true;
end
else begin
write (outfile, ^[, 'T');
sub := false;
end;
else write (outfile, letter);
end; { case }
end; { while not eof }
end; { procedure pcw2pe }
{======================================}
{SECTION TO CHOOSE TRANSLATION ROUTINES}
{======================================}
procedure asciiroutine;
begin
case outformat of
'B', 'b' : ascii2ws;
'C', 'c' : ascii2wp;
{ D not used - ascii2pe not needed }
'E', 'e' : ascii2pcw;
end; {case}
end; {ascii routine}
procedure wsroutine;
begin
case outformat of
'A', 'a' : ws2ascii;
'C', 'c' : ws2wp;
'D', 'd' : ws2pe;
'E', 'e' : ws2pcw;
end; {case}
end; {wsroutine}
procedure wproutine;
begin
case outformat of
'A', 'a' : wp2ascii;
'B', 'b' : wp2ws;
'D', 'd' : wp2pe;
'E', 'e' : wp2pcw;
end; { case }
end; {procedure wproutine}
procedure peroutine;
begin
case outformat of
'A', 'a' : pe2ascii;
'B', 'b' : pe2ws;
'C', 'c' : pe2wp;
'E', 'e' : pe2pcw;
end; { case }
end; { peroutine }
procedure pcwroutine;
begin
case outformat of
'A', 'a' : pcw2ascii;
'B', 'b' : pcw2ws;
'C', 'c' : pcw2wp;
'D', 'd' : pcw2pe;
end; { case }
end; { pcwroutine }
procedure chooseroutine;
begin
case informat of
'A', 'a' : asciiroutine;
'B', 'b' : wsroutine;
'C', 'c' : wproutine;
'D', 'd' : peroutine;
'E', 'e' : pcwroutine;
end; { case }
end;
{=================}
{MAIN PROGRAM LINE}
{=================}
begin {context}
firstScreen;
repeat
write (' Source '); getformat (informat)
until valid;
getinfile;
repeat
write (' Destination '); getformat (outformat)
until valid;
If upcase(outformat) = upcase(informat) then
writeln (' No translation routine required. Ending program.');
If upcase(outformat) = upcase(informat) then goto quit;
if (upcase (outformat) = 'A') and (upcase (outformat) = 'D') then
writeln ('Personal Editor reads pure ASCII files. No translation needed.');
if (upcase (outformat) = 'A') and (upcase (outformat) = 'D') then goto quit;
getoutfile;
writeln;
writeln (' Reading file: ', inname);
writeln (' Producing file: ', outname);
chooseroutine;
close (outfile);
writeln; writeln (' Done.'); writeln;
quit : close (infile);
end.